home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / parallax / more_exa.tar / more / Graphics / raytrace.p < prev    next >
Text File  |  1991-11-18  |  59KB  |  1,732 lines
  1. (***************************************************************************)
  2. (*                                         *)
  3. (*  Pixelparallel Raytracing-Algorithm                                     *)
  4. (*                                         *)
  5. (*                                         *)
  6. (*  Author:             Sabine Liebelt                                     *)
  7. (*  File:               trace.p                          *)
  8. (*  Language:           Parallaxis                       *)
  9. (*                                         *)
  10. (***************************************************************************)
  11.  
  12. SYSTEM sys_trace;
  13.  
  14. CONST
  15.      MaxSph = 100;             (*  maximal number spheres        *)
  16.      MaxPoly = 100;             (*  maximal number polygone       *)
  17.      MaxVertices = 4;             (*  maximal number polygon-corner *)
  18.      MaxLights = 5;             (*  maximal number Lights         *)
  19.      MaxDepth = 3;             (*  maximal depth of raytracing   *)
  20.      MinWeight = 0.001;             (*  minimal weighting factor      *)
  21.      Size = 300;                 (*  image-size              *)
  22.      RayEps = 0.0001;                   (*  factor of variation       *)
  23.  
  24. TYPE
  25.      RGB = ARRAY [1..3] OF REAL;     (*  values between 0 and 1       *)
  26.  
  27.      Vec = ARRAY [1..3] OF REAL;
  28.  
  29.      Ray = RECORD
  30.                 p, d: Vec;
  31.            END;
  32.  
  33.      Sphere = RECORD
  34.                        center: Vec;
  35.                        radius: REAL;
  36.                         kdr: REAL;         (*  coefficients for Shading       *)
  37.                         ksr: REAL;
  38.                         shine: REAL;
  39.                         kst: REAL;        
  40.                         eta: REAL;
  41.                         color: RGB;            
  42.               END;
  43.  
  44.      Polygon = RECORD
  45.                         normal: Vec;
  46.                         d: REAL;
  47.                         xy: BOOLEAN;     (*  TRUE: projection on xy-plain  *)
  48.                           (*        usefull           *)
  49.                         xz: BOOLEAN;     (*  TRUE: projektion on xz-plain  *)
  50.                           (*        usefull           *)
  51.                         side: INTEGER;     (*  1:normalvector has pos. z-component*)
  52.                           (* -1:normalvector has neg. z-component*)
  53.                         vertices: ARRAY [1..MaxVertices] OF Vec;
  54.                         vcount: INTEGER;
  55.                         kdr: REAL;         (*  coefficients for Shading       *)
  56.                         ksr: REAL;
  57.                         shine: REAL;
  58.                         kst: REAL;
  59.                         eta: REAL;
  60.                         color: RGB;            
  61.                 END;
  62.  
  63.      SphList = ARRAY [1..MaxSph] OF Sphere;
  64.  
  65.      PolyList = ARRAY [1..MaxPoly] OF Polygon;
  66.  
  67.      ObjTyp = (none, sph, poly);
  68.  
  69.      Object = RECORD
  70.                         typ: ObjTyp;
  71.                         poly: Polygon;
  72.                         sph: Sphere;
  73.                 END;
  74.  
  75.      Viewer = RECORD
  76.                         pos: Vec;         (*  point of view           *)
  77.                         at: Vec;         (*  direction of view           *)
  78.                         up: Vec;         (*  direction above           *)
  79.                         angle: REAL;     (*  view-angle in degree          *)
  80.                END;
  81.  
  82.      Light = RECORD
  83.                 pos: Vec;
  84.                 intensity: RGB;
  85.               END;
  86.  
  87.      LightList = ARRAY [1..MaxLights] OF Light;
  88.  
  89.      string = ARRAY [1..50] OF CHAR;
  90.  
  91.  
  92. CONFIGURATION Field [1..Size],[1..Size];
  93. CONNECTION;
  94.  
  95. SCALAR
  96.      eye: Viewer;             (*  viewer               *)
  97.      depth: INTEGER;             (*  depth of recursion           *)
  98.      sphcount: INTEGER;             (*  spherecounter           *)
  99.      polycount: INTEGER;             (*  polygoncounter           *)
  100.      sl: SphList;             (*  spherelist            *)
  101.      pl: PolyList;             (*  polygonlist           *)  
  102.      lightcount: INTEGER;         (*  lightcounter              *)
  103.      ll: LightList;             (*  lightlist             *)
  104.      amb: RGB;
  105.      background: RGB;
  106.      picfile, objfile, inputf: string;
  107.      i, j: INTEGER;             (*  counter               *)
  108.      pixfield: ARRAY [1..Size],[1..Size] OF RGB;
  109.      m: REAL;                 (*  max. component of current     *)
  110.                           (*  colorvector           *)
  111.      aktu_color: RGB;             (*  color of current pixel       *)
  112.  
  113. VECTOR
  114.      iray: Ray;
  115.      color: RGB;
  116.      Vecpoly: Polygon;
  117.  
  118.  
  119. PROCEDURE strcat( SCALAR first , second : string ) : SCALAR string ;
  120. (***************************************************************************)
  121. (*  concatenates two strings                                               *)
  122. (***************************************************************************)
  123.  
  124.   SCALAR
  125.    i , j : INTEGER;
  126.  
  127.   BEGIN
  128.    i := 1 ; j := 1 ;
  129.    WHILE first[i] <> CHR(0) DO INC(i) ; END ;
  130.    WHILE second[j] <> CHR(0) DO first[i] := second[j] ; INC(j) ; INC(i) ; END ; 
  131.    first[i] := CHR(0) ;
  132.  
  133.    RETURN first ;
  134.   END strcat ;
  135.     
  136.  
  137. (********* READ DATA AND CREATE DATASTRUCTURE ******************************)
  138.  
  139.  
  140. PROCEDURE createscene ();
  141. (***************************************************************************)
  142. (*                                         *)
  143. (*  subprocedures:                               *)
  144. (*  get_viewer, get_light, get_background, get_poly, get_patch, get_sphere,*)
  145. (*  get_material, Read_comment                               *)
  146. (*                                           *)
  147. (*  global variables:                                                      *)
  148. (*                                                                           *)
  149. (*  function:                                                               *)
  150. (*  read viewer, object and light-data.                                    *)
  151. (*  If no viewer exist, then program will be terminated. If more than one  *)
  152. (*  viewer exist, then the last one would be used.                         *)
  153. (*                                         *)
  154. (*  Inputfile has to be in NFF-format :                        *)
  155. (*                                         *)
  156. (*  #  Viewpoint                                *)
  157. (*  v  from  pos_x  pos_y  pos_z                       *)
  158. (*     at    at_x  at_y  at_z                           *)
  159. (*     up    x  y  z                               *)
  160. (*     angle  alpha                               *)
  161. (*     hither dist                               *)
  162. (*     resolution x y                               *)
  163. (*  # Lights                                        *)
  164. (*  l pos_x  pos_y  pos_z  r  g  b                       *)
  165. (*  # Backgroundcolor                               *)
  166. (*  b r  g  b                                   *)
  167. (*  # Material                                   *)
  168. (*  r  g  b  kdr  ksr  shine kst  eta                       *) 
  169. (*  # Spheres                                   *)
  170. (*  K cen_x  cen_y  cen_z  rad                         *)
  171. (*  # Polygones                                   *)
  172. (*  P num.Corners x y z  x y z  ...                         *)
  173. (*                                                                          *)
  174. (***************************************************************************)
  175.  
  176. SCALAR
  177.      view: BOOLEAN;             (*  TRUE = viewer known           *)
  178.                       (*  FALSE = viewer still unknown  *)
  179.      back: BOOLEAN;             (*  TRUE = background known       *)
  180.                       (*  FALSE = background still unknown *)
  181.      material: BOOLEAN;             (*  TRUE = surface known          *)
  182.                           (*  FALSE = surface still unknown *)
  183.      mat: RECORD             (*  current material           *)
  184.                 color: RGB;
  185.                 kdr: REAL;
  186.                 ksr: REAL;
  187.                 shine: REAL;
  188.                 kst: REAL;
  189.                 eta: REAL;
  190.            END;
  191.      t: string;                 (*  s = sphere              *)
  192.                       (*  l = light                    *)
  193.                           (*  p = polygon           *)
  194.                           (*  v = viewer            *)
  195.  
  196.  
  197. PROCEDURE get_viewer();
  198. (***************************************************************************)
  199. (*                                         *)
  200. (*  calling procedure:                               *)
  201. (*  createscene                                   *)
  202. (*                                                                           *)
  203. (*  global variable:                                                      *)
  204. (*  eye                                       *)
  205. (*                                                                           *)
  206. (*  function:                                                               *)
  207. (*  to read viewerdata from file                                             *)
  208. (*                                                                           *)
  209. (***************************************************************************)
  210.  
  211. SCALAR
  212.      i: INTEGER;             (*  counter                         *)
  213.      next: string;
  214.      resx, resy: INTEGER;
  215.      hither: REAL;
  216.  
  217. BEGIN
  218.      IF view THEN
  219.            WriteString ("WARNING: more than one viewer specified.");
  220.            WriteLn;
  221.            WriteString ("         use last one.");
  222.            WriteLn;
  223.      ELSE
  224.            view := TRUE;
  225.      END;
  226.  
  227.      IF Done THEN
  228.            ReadString (next);
  229.      END;
  230.  
  231.      IF STRCMP (next, "from") = 0 THEN
  232.  
  233. (*  read position                                *)
  234.            i := 1;
  235.            WHILE Done & (i <= 3) DO
  236.                 ReadReal (eye.pos[i]);
  237.                 INC (i);
  238.            END (* while *);
  239.      ELSE
  240.            WriteString ("ERROR: viewerposition not correct.");
  241.            HALT;
  242.      END;
  243.  
  244.      IF Done THEN
  245.            ReadString (next);
  246.      END;
  247.  
  248.      IF STRCMP (next, "at") = 0 THEN
  249.  
  250. (*  read direction of view                           *)
  251.            i := 1;
  252.            WHILE Done & (i <= 3) DO
  253.                 ReadReal (eye.at[i]);
  254.                 INC (i);
  255.            END (* while *);
  256.      ELSE
  257.            WriteString ("ERROR: direction of view not correct.");
  258.            HALT;
  259.      END;
  260.      
  261.      IF Done THEN
  262.            ReadString (next);
  263.      END;
  264.  
  265.      IF STRCMP (next, "up") = 0 THEN
  266.  
  267. (*  read direction of view                           *)
  268.            i := 1;
  269.            WHILE Done & (i <= 3) DO
  270.                 ReadReal (eye.up[i]);
  271.                 INC (i);
  272.            END (* while *);
  273.      ELSE
  274.            WriteString ("ERROR: viewerdata not correct.");
  275.            HALT;
  276.      END;
  277.  
  278.      IF Done THEN
  279.            ReadString (next);
  280.      END;
  281.  
  282.      IF STRCMP (next, "angle") = 0 THEN
  283.  
  284. (*  read viewing angle                                 *)
  285.            ReadReal (eye.angle);
  286.      ELSE
  287.            WriteString ("ERROR: viewing angle not correct.");
  288.            HALT;
  289.      END;
  290.  
  291.      IF Done THEN
  292.            ReadString (next);
  293.      END;
  294.  
  295.      IF STRCMP (next, "hither") = 0 THEN
  296.  
  297.            ReadReal (hither);
  298.      ELSE
  299.            WriteString ("ERROR: viewerdata not correct.");
  300.            HALT;
  301.      END;
  302.    
  303.      IF Done THEN
  304.            ReadString (next);
  305.      END;
  306.  
  307.      IF STRCMP (next, "resolution") = 0 THEN
  308.  
  309.            ReadInt (resx);
  310.            ReadInt (resy);
  311.      ELSE
  312.            WriteString ("ERROR: viewerdata not correct.");
  313.            HALT;
  314.      END;
  315.  
  316.      IF (resx <> Size) OR (resy <> Size) THEN
  317.            WriteString ("Using default imagesize for resolution.");
  318.            WriteLn;
  319.      END;
  320.      RETURN;
  321.            
  322. END get_viewer;
  323.  
  324.  
  325. PROCEDURE get_light ();
  326. (***************************************************************************)
  327. (*                                         *)
  328. (*  calling procedure:                               *)
  329. (*  createscene                                   *)
  330. (*                                                                           *)
  331. (*  global variable:                                                      *)
  332. (*  ll                                       *)
  333. (*                                                                           *)
  334. (*  function:                                                               *)
  335. (*  read data of one light.                                    *)
  336. (*                                                                           *)
  337. (***************************************************************************)
  338.  
  339. SCALAR
  340.      i: INTEGER;             (*  counter                *)
  341.      l: string;
  342.  
  343. BEGIN
  344.  
  345. (*  increase number of lights and check, if max number is not overcrossed  *)
  346.      INC (lightcount);
  347.      IF (lightcount > MaxLights) THEN
  348.            WriteString ("ERROR: too much lights, maximal");
  349.            WriteInt (MaxLights,2);
  350.            HALT;
  351.      END (* if *);
  352.  
  353. (*  read position                                *)
  354.      i := 1;
  355.      WHILE Done & (i <= 3) DO
  356.            ReadReal (ll[lightcount].pos[i]);
  357.            INC (i);
  358.      END (* while *);
  359.  
  360. (*  read intensity of light                          *)
  361.      i := 1;
  362.      WHILE Done & (i <= 3) DO
  363.            ReadReal (ll[lightcount].intensity[i]);
  364.            INC (i);
  365.      END (* while *);
  366.  
  367.      IF NOT Done THEN
  368.            WriteString ("ERROR: lightdata not correct.");
  369.            HALT;
  370.      END;
  371. END get_light;
  372.  
  373.  
  374. PROCEDURE get_background ();
  375. (***************************************************************************)
  376. (*                                             *)        
  377. (*  calling  procedure:                               *)
  378. (*  createscene                                   *)
  379. (*                                                                           *)
  380. (*  global variable:                                                      *)
  381. (*  back                                   *)
  382. (*                                                                           *)
  383. (*  function:                                                               *)
  384. (*  read background data.                                     *)
  385. (*                                                                           *)
  386. (***************************************************************************)
  387.  
  388. SCALAR
  389.      i: INTEGER;             (*  counter                   *)
  390.  
  391. BEGIN
  392.  
  393.      IF back THEN
  394.            WriteString ("WARNING: more than one background-color specified.");
  395.            WriteLn;
  396.            WriteString ("         use last one.");
  397.            WriteLn;
  398.      ELSE
  399.            back := TRUE;
  400.      END;
  401.  
  402.      i := 1;
  403.      WHILE Done & (i <= 3) DO
  404.            ReadReal (background[i]);
  405.            INC (i);
  406.      END (* while *);
  407.  
  408.      IF NOT Done THEN
  409.            WriteString ("ERROR: background-data not correct.");
  410.            HALT;
  411.      END;
  412. END get_background;
  413.  
  414.  
  415. PROCEDURE get_material ();
  416. (***************************************************************************)
  417. (*                                         *)
  418. (*  calling procedure:                               *)
  419. (*  createscene                                   *)
  420. (*                                                                           *)
  421. (*  global variable:                                                      *)
  422. (*                                                                           *)
  423. (*  function:                                  *)
  424. (*  read surface-data for the following object.                           *)
  425. (*                                                                           *)
  426. (***************************************************************************)
  427.  
  428. BEGIN
  429.      material := TRUE;
  430.      IF Done THEN
  431.            ReadReal (mat.color[1]);
  432.            ReadReal (mat.color[2]);
  433.            ReadReal (mat.color[3]);
  434.            ReadReal (mat.kdr);
  435.            ReadReal (mat.ksr);
  436.            ReadReal (mat.shine);
  437.            ReadReal (mat.kst);
  438.            ReadReal (mat.eta);
  439.      END;
  440.  
  441.      IF NOT Done THEN
  442.            WriteString ("WARNING: surface-description not correct.");
  443.      END;
  444. END get_material;
  445.  
  446.  
  447. PROCEDURE get_sphere ();
  448. (***************************************************************************)
  449. (*                                         *)
  450. (*  calling procedure:                               *)
  451. (*  createscene                                   *)
  452. (*                                                                           *)
  453. (*  global variable:                                                      *)
  454. (*  sl                                       *)
  455. (*                                                                           *)
  456. (*  function:                                                               *)
  457. (*  read sphere-data.                                          *)
  458. (*                                                                           *)
  459. (***************************************************************************)
  460.  
  461. SCALAR
  462.      i: INTEGER;             (*  counter                   *)
  463.  
  464. BEGIN
  465. (*  increase number of spheres and check, if max number is not overcrossed *)
  466.      INC (sphcount);
  467.      IF (sphcount > MaxSph) THEN
  468.            WriteString ("ERROR: too much spheres, maximal");
  469.            WriteInt (MaxSph,2);
  470.            HALT;
  471.      END (* if *);
  472.      
  473. (*  read sphere-data.                                       *)
  474.      i := 1;
  475.       WHILE (Done) AND (i < 4) DO
  476.            ReadReal (sl[sphcount].center[i]);
  477.            i := i + 1;
  478.      END (* while *);
  479.      ReadReal (sl[sphcount].radius);
  480.  
  481.      IF (NOT Done)  THEN
  482.            WriteString ("ERROR: sphere-format not correct.");
  483.            HALT;
  484.      END (* if *);
  485.  
  486.      IF NOT material THEN
  487.            WriteString ("WARNING: no surface-description for object.");
  488.      END;
  489.  
  490.      sl[sphcount].color := mat.color;
  491.      sl[sphcount].kdr := mat.kdr;
  492.      sl[sphcount].ksr := mat.ksr;
  493.      sl[sphcount].kst := mat.kst;
  494.      sl[sphcount].shine := mat.shine;
  495.      sl[sphcount].eta := mat.eta;
  496.  
  497. END get_sphere;
  498.  
  499.  
  500. PROCEDURE get_poly ();
  501. (***************************************************************************)
  502. (*                                         *)
  503. (*  calling procedure:                               *)
  504. (*  createscene                                   *)
  505. (*                                                                           *)
  506. (*  global variable:                                                      *)
  507. (*  pl                                       *)
  508. (*                                                                           *)
  509. (*  function:                                                               *)
  510. (*  read polygone-data                                                      *)
  511. (*                                                                           *)
  512. (***************************************************************************)
  513.  
  514. SCALAR
  515.      i: INTEGER;             (*  counter                   *)
  516. BEGIN
  517. (* increase number of polygones and check, if max number is not overcrossed*)
  518.      INC (polycount);
  519.      IF (polycount > MaxPoly) THEN
  520.            WriteString ("ERROR: too much polygones, maximal");
  521.            WriteInt (MaxPoly,2);
  522.            HALT;
  523.      END (* if *);
  524.  
  525. (*  read corners of polygones.                           *)
  526.      ReadInt (pl[polycount].vcount);
  527.      i := 1;
  528.      WHILE (i <= pl[polycount].vcount) & Done DO
  529.            ReadReal (pl[polycount].vertices[i][1]);
  530.            ReadReal (pl[polycount].vertices[i][2]);
  531.            ReadReal (pl[polycount].vertices[i][3]);
  532.            INC (i);
  533.      END (* while *);
  534.  
  535.      IF NOT Done THEN
  536.            WriteString ("ERROR: polygone-data not correct.");
  537.            HALT;
  538.      END;
  539.  
  540.      IF NOT material THEN
  541.            WriteString ("WARNING: no surface-description for object.");
  542.      END;
  543.  
  544.      pl[polycount].color := mat.color;
  545.      pl[polycount].kdr := mat.kdr;
  546.      pl[polycount].ksr := mat.ksr;
  547.      pl[polycount].shine := mat.shine;
  548.      pl[polycount].kst := mat.kst;
  549.      pl[polycount].eta := mat.eta;
  550. END get_poly;
  551.  
  552.  
  553. PROCEDURE get_patch ();
  554. (***************************************************************************)
  555. (*                                         *)
  556. (*  calling procedure:                               *)
  557. (*  createscene                                   *)
  558. (*                                                                           *)
  559. (*  global variable:                                                      *)
  560. (*  pl                                       *)
  561. (*                                                                           *)
  562. (*  function:                                                               *)
  563. (*  read polygone-data.                                                      *)
  564. (*                                                                           *)
  565. (***************************************************************************)
  566.  
  567. SCALAR
  568.      i: INTEGER;             (*  counter                *)
  569.      h: REAL;
  570.  
  571. BEGIN
  572. (* increase number of polygones and check, if max number is not overcrossed*)
  573.      INC (polycount);
  574.      IF (polycount > MaxPoly) THEN
  575.            WriteString ("ERROR: too much polygones, maximal");
  576.            WriteInt (MaxPoly,2);
  577.            HALT;
  578.      END (* if *);
  579.  
  580. (*  read corners of polygones.                           *)
  581.      ReadInt (pl[polycount].vcount);
  582.      i := 1;
  583.      WHILE (i <= pl[polycount].vcount) & Done DO
  584.            ReadReal (pl[polycount].vertices[i][1]);
  585.            ReadReal (pl[polycount].vertices[i][2]);
  586.            ReadReal (pl[polycount].vertices[i][3]);
  587. (*  Normalen ueberlesen                               *)
  588.            ReadReal (h);
  589.            ReadReal (h);
  590.            ReadReal (h);
  591.            INC (i);
  592.      END (* while *);
  593.  
  594.      IF NOT Done THEN
  595.            WriteString ("ERROR: polygone-data not correct.");
  596.            HALT;
  597.      END;
  598.  
  599.      IF NOT material THEN
  600.            WriteString ("WARNING: no surface-description for object.");
  601.      END;
  602.  
  603.      pl[polycount].color := mat.color;
  604.      pl[polycount].kdr := mat.kdr;
  605.      pl[polycount].ksr := mat.ksr;
  606.      pl[polycount].shine := mat.shine;
  607.      pl[polycount].kst := mat.kst;
  608.      pl[polycount].eta := mat.eta;
  609. END get_patch;
  610.  
  611.  
  612. PROCEDURE Read_comment ();
  613. (***************************************************************************)
  614. (*                                         *)
  615. (*  calling procedure:                               *)
  616. (*  createscene                                   *)
  617. (*                                                                           *)
  618. (*  function:                                                               *)
  619. (*  read line untill eoln                           *)
  620. (*                                                                           *)
  621. (***************************************************************************)
  622.  
  623. SCALAR
  624.      c: CHAR;
  625.  
  626. BEGIN
  627.      REPEAT
  628.            Read (c);
  629.      UNTIL (NOT Done) OR (c = EOL);
  630. END Read_comment;
  631.  
  632.  
  633. BEGIN  (* createscene *)
  634.  
  635.      lightcount := 0;
  636.      sphcount := 0;
  637.      polycount := 0;
  638.      view := FALSE;
  639.      back := FALSE;
  640.      material := FALSE;
  641.  
  642.      OpenInput (objfile);
  643.      IF (Done) THEN
  644.       ReadString (t);
  645.      ELSE
  646.            WriteString ("ERROR: can't open inputfile");
  647.            HALT;
  648.      END (* if *);
  649.  
  650.      WHILE (Done) DO
  651.            IF STRCMP (t, "v") = 0 THEN
  652.                 get_viewer; 
  653.                 Read_comment; 
  654.            ELSIF STRCMP (t, "l") = 0 THEN
  655.                 get_light; 
  656.                 Read_comment; 
  657.            ELSIF STRCMP (t, "f") = 0 THEN
  658.                 get_material; 
  659.                 Read_comment; 
  660.            ELSIF STRCMP (t, "b") = 0 THEN
  661.                 get_background; 
  662.                 Read_comment; 
  663.            ELSIF STRCMP (t, "s") = 0 THEN
  664.                 get_sphere; 
  665.                 Read_comment; 
  666.            ELSIF STRCMP (t, "p") = 0 THEN
  667.                 get_poly; 
  668.                 Read_comment ;
  669.            ELSIF STRCMP (t, "pp") = 0 THEN
  670.                 get_patch; 
  671.                 Read_comment ;
  672.            ELSIF STRCMP (t, "#") = 0 THEN
  673.                 Read_comment; 
  674.            ELSE
  675.                 WriteString ("ERROR: wrong tag in inputfile.");
  676.                 HALT;
  677.            END;
  678.  
  679.            IF Done THEN
  680.                 ReadString (t);
  681.            END;
  682.      END (* while *);
  683.  
  684.      IF NOT back THEN
  685.            init_s (background);
  686.      END;
  687.  
  688.      IF NOT view THEN
  689.            WriteString ("ERROR: no viewer specified.");
  690.            HALT;
  691.      END;
  692.  
  693.      amb[1] := .035;
  694.      amb[2] := .035;
  695.      amb[3] := .035;
  696.  
  697. END createscene;
  698.  
  699.  
  700. PROCEDURE planes  ();
  701. (***************************************************************************)
  702. (*                                         *)
  703. (*  global variable:                                                      *)
  704. (*  pl, polycount                               *)
  705. (*                                                                           *)
  706. (*  function:                                                               *)
  707. (*  calculates out of the first three corners the plain-coefficient of     *)
  708. (*  the polygone: Ax + By + Cz + D = 0.                       *)
  709. (*  A, B, C represent the normalvector, which is scaled on length 1        *)
  710. (*  and adjusting D corresponding                                             *)         
  711. (*                                                                            *)
  712. (***************************************************************************)
  713. SCALAR
  714.      x :INTEGER;
  715.  
  716. VECTOR
  717.      v1, v2: Vec;             (*  edge-vectors           *)
  718.      i: INTEGER;             (*  counter                    *)
  719.      r: REAL;
  720.      dot: REAL;
  721.  
  722. BEGIN
  723.      x := MaxPoly;
  724.  
  725.      LOAD [1],[1..polycount] (Vecpoly, pl,x); 
  726.  
  727.      PARALLEL [1],[1..polycount]
  728.  
  729. (*  calculating coefficients                           *)
  730.            v1[1] := Vecpoly.vertices[2][1] - Vecpoly.vertices[1][1];
  731.            v1[2] := Vecpoly.vertices[2][2] - Vecpoly.vertices[1][2];
  732.            v1[3] := Vecpoly.vertices[2][3] - Vecpoly.vertices[1][3];
  733.            v2[1] := Vecpoly.vertices[3][1] - Vecpoly.vertices[2][1];
  734.            v2[2] := Vecpoly.vertices[3][2] - Vecpoly.vertices[2][2];
  735.            v2[3] := Vecpoly.vertices[3][3] - Vecpoly.vertices[2][3];
  736.  
  737.            Vecpoly.normal[1] := v1[2] * v2[3] - v1[3] * v2[2];
  738.         Vecpoly.normal[2] := v2[1] * v1[3] - v2[3] * v1[1];
  739.            Vecpoly.normal[3] := v1[1] * v2[2] - v1[2] * v2[1];
  740.            Vecpoly.d := - Vecpoly.normal[1] * Vecpoly.vertices [1][1] -
  741.                           Vecpoly.normal[2] * Vecpoly.vertices [1][2] - 
  742.                              Vecpoly.normal[3] * Vecpoly.vertices [1][3];
  743.  
  744. (*  check, if points represents a plain                      *)
  745.            IF (Vecpoly.normal[1] = 0.0) AND (Vecpoly.normal[2] = 0.0) AND 
  746.               (Vecpoly.normal[3] = 0.0) AND (Vecpoly.d  = 0.0) THEN
  747.                 WriteString ("ERROR: polygonpoints represent no plain");
  748.                 HALT;
  749.       END (* if *);
  750.  
  751.            i := 4;
  752.            WHILE i <= Vecpoly.vcount DO
  753.            IF (ABS(Vecpoly.normal[1]*Vecpoly.vertices[i][1] + 
  754.                            Vecpoly.normal[2]*Vecpoly.vertices[i][2] + 
  755.                            Vecpoly.normal[3]*Vecpoly.vertices[i][3] +
  756.                Vecpoly.d) > .001) THEN
  757.                         WriteString ("ERROR: points represent no plain");
  758.                         HALT;    
  759.            END (* if *);
  760.  
  761.                 INC (i);
  762.            END (* while *);
  763.  
  764. (*  scaling normalvector and adjusting d corresponding.            *)
  765.            Vecdot_vv (Vecpoly.normal, Vecpoly.normal, dot);
  766.            Veccompr_v (1./Sqrt (dot), Vecpoly.normal);
  767.            Vecpoly.d := Vecpoly.d / Sqrt(dot);
  768.  
  769. (*  helpvariables for the polygoninintersectionroutine               *)
  770.            IF (ABS (Vecpoly.normal[3]) <> 0.) THEN 
  771.                 Vecpoly.xy := TRUE;
  772.                 Vecpoly.xz := FALSE;
  773.                 Vecpoly.side := 
  774.                 TRUNC (Vecpoly.normal[3] / ABS (Vecpoly.normal[3]));
  775.            ELSIF (ABS (Vecpoly.normal[2]) <> 0.) THEN
  776.                 Vecpoly.xz := TRUE;
  777.                 Vecpoly.xy := FALSE;
  778.                 Vecpoly.side := 
  779.                 TRUNC (Vecpoly.normal[2] / ABS (Vecpoly.normal[2]));
  780.            ELSE 
  781.                 Vecpoly.xy := FALSE;
  782.                 Vecpoly.xz := FALSE;
  783.                 Vecpoly.side := 
  784.                 TRUNC (Vecpoly.normal[1] / ABS (Vecpoly.normal[1]));
  785.            END;
  786.  
  787.  
  788.      ENDPARALLEL;
  789.      x := MaxPoly;
  790.      STORE [1],[1..polycount] (Vecpoly, pl,x);
  791. END planes;
  792.  
  793.  
  794.  
  795. (*********************** GENERAL HELP-PROCEDURES ***********************)
  796.  
  797.  
  798.  
  799. PROCEDURE initrays ();
  800. (***************************************************************************)
  801. (*                                         *)
  802. (*  global variables:                                                      *)
  803. (*  iray, eye                                   *)
  804. (*                                                                          *)
  805. (*  function:                                                               *)
  806. (*  Calculation of the initial rays per pixel.                             *)
  807. (*  It would be attempt to distribute as much as possible PEs equal over   *)
  808. (*  the viewing angle put up by the viewer. As virtual picture-plain there *)
  809. (*  would be used the plain in the distance 'eye.at[3]'. This plain is        *)
  810. (*  only necessary for the calculation of the PE-density per unit.         *)
  811. (*  The final initial rays depends only on the viewing angle.              *)
  812. (*                                                                           *)
  813. (***************************************************************************)
  814.  
  815. SCALAR
  816.      v: Vec;                 (*  direction              *)
  817.      up: Vec;                     (*  vertical direction         *)
  818.      right: Vec;             (*  horizontal direction        *)
  819.      
  820. VECTOR
  821.      t: REAL;                        (*  helping variables           *)
  822.  
  823. BEGIN
  824.      Veccomb_ss (1., -1., eye.at, eye.pos, v);
  825.  
  826. (*  calculation of the horizontal rellocation-vector                        *)
  827.      Vecunit_s (v);
  828.      vcross_ss (v, eye.up, right);
  829.      Vecunit_s (right);
  830.  
  831. (*  calculation of the horizontal rellocation-vector                        *)
  832.      vcross_ss (right,v, up);
  833.      Vecunit_s (up);
  834.  
  835. (*  calculation of the direction of initial rays                           *)
  836.      PARALLEL
  837.            iray.p := eye.pos;
  838.            t := Tan (eye.angle / 360. * PI) * 
  839.                         (-1. + 2. * FLOAT (DIM2 - 1) / FLOAT (Size));
  840.                 Veccomb_vv (t, 1., right, v, iray.d);
  841.                 t := Tan (eye.angle / 360. * PI) * 
  842.                         (1. - 2. * FLOAT (DIM1 - 1) / FLOAT (Size));
  843.                 Veccomb_vv (1., t, iray.d, up, iray.d);
  844.                Vecunit_v (iray.d);
  845.  
  846.      ENDPARALLEL;
  847.  
  848. END initrays;
  849.  
  850.  
  851. PROCEDURE round (SCALAR x: REAL): SCALAR INTEGER;
  852. (***************************************************************************)
  853. (*                                         *)
  854. (*  function:                                                               *)
  855. (*  returns rounded integer value                                            *)
  856. (*                                                                           *)
  857. (***************************************************************************)
  858.  
  859. SCALAR
  860.      z:   REAL;                 (*  helping variables           *)
  861.  
  862. BEGIN
  863.      z := x * 10. - FLOAT (TRUNC (x)*10);
  864.      IF z < 0.0 THEN
  865.            IF (z <= -5.) THEN
  866.                 RETURN (TRUNC (x-1.));
  867.            ELSE
  868.                 RETURN (TRUNC (x));
  869.            END (* if *);
  870.      ELSE
  871.            IF (z >= 5.) THEN
  872.                 RETURN (TRUNC (x+1.));
  873.            ELSE
  874.                 RETURN (TRUNC (x));
  875.            END (* if *);
  876.      END (* if *);
  877.  
  878. END round;
  879.  
  880.  
  881.  
  882. (************************** VECTOR-PROCEDURES *******************************)
  883.  
  884.  
  885.      
  886. PROCEDURE Veccomb_vv (VECTOR a,b: REAL; VECTOR va,vb: Vec; VECTOR VAR vc: Vec);
  887. (***************************************************************************)
  888. (*                                         *)
  889. (*  function:                                                               *)
  890. (*  vectorial vectoraddition: vc = a*va + b*vb                               *)
  891. (*                                                                           *)
  892. (*                                                                           *)
  893. (***************************************************************************)
  894.  
  895. BEGIN
  896.      vc[1] := a * va[1] + b * vb[1];
  897.      vc[2] := a * va[2] + b * vb[2];
  898.      vc[3] := a * va[3] + b * vb[3];
  899. END Veccomb_vv;
  900.  
  901.  
  902. PROCEDURE Veccomb_vs (SCALAR a,b: REAL; VECTOR va: Vec; 
  903.                            SCALAR vb: Vec; VECTOR VAR vc: Vec);
  904. (***************************************************************************)
  905. (*                                         *)
  906. (*  function:                                                                *)
  907. (*  vectoraddition: vc = a*va + b*vb                                   *)
  908. (*                                                                           *)
  909. (*                                                                           *)
  910. (***************************************************************************)
  911.  
  912. BEGIN
  913.      vc[1] := a * va[1] + b * vb[1];
  914.      vc[2] := a * va[2] + b * vb[2];
  915.      vc[3] := a * va[3] + b * vb[3];
  916. END Veccomb_vs;
  917.  
  918.  
  919. PROCEDURE Veccomb_ss (SCALAR a,b: REAL; SCALAR va: Vec; 
  920.                            SCALAR vb: Vec; SCALAR VAR vc: Vec);
  921. (***************************************************************************)
  922. (*                                         *)
  923. (*  function:                                                               *)
  924. (*  vectoraddition: vc = a*va + b*vb                                   *)
  925. (*                                                                           *)
  926. (*                                                                           *)
  927. (***************************************************************************)
  928.  
  929. BEGIN
  930.      vc[1] := a * va[1] + b * vb[1];
  931.      vc[2] := a * va[2] + b * vb[2];
  932.      vc[3] := a * va[3] + b * vb[3];
  933. END Veccomb_ss;
  934.  
  935.  
  936. PROCEDURE Vecdot_vv (VECTOR va, vb: Vec; VECTOR VAR d: REAL);
  937. (***************************************************************************)
  938. (*                                         *)
  939. (*  function:                                                               *)
  940. (*  vectorial vectormultiplication: vc = a*va + vb               *)
  941. (*                                                                           *)
  942. (***************************************************************************)
  943.  
  944. BEGIN
  945.      d := va[1]*vb[1] + va[2]*vb[2] + va[3]*vb[3];
  946. END Vecdot_vv;
  947.  
  948. PROCEDURE Vecdot_sv (SCALAR va: Vec; VECTOR vb: Vec; VECTOR VAR d: REAL);
  949. (***************************************************************************)
  950. (*                                         *)
  951. (*  function:                                                               *)
  952. (*  vectorial vectormultiplication: vc = a*va + vb               *)
  953. (*                                                                           *)
  954. (***************************************************************************)
  955.  
  956. BEGIN
  957.      d := va[1]*vb[1] + va[2]*vb[2] + va[3]*vb[3];
  958. END Vecdot_sv;
  959.  
  960. PROCEDURE Vecdot_ss (SCALAR va, vb: Vec; SCALAR VAR d: REAL);
  961. (***************************************************************************)
  962. (*                                         *)
  963. (*  function:                                                               *)
  964. (*  scalar  vectormultiplication: vc = a*va + vb               *)
  965. (*                                                                           *)
  966. (***************************************************************************)
  967.  
  968. BEGIN
  969.      d := va[1]*vb[1] + va[2]*vb[2] + va[3]*vb[3];
  970. END Vecdot_ss;
  971.  
  972.  
  973. PROCEDURE vcross_ss (SCALAR va, vb: Vec; SCALAR VAR vc: Vec);
  974. (***************************************************************************)
  975. (*                                         *)
  976. (*  function:                                                               *)
  977. (*  calculation of the crossproduct of va and vb.               *)
  978. (*                                                                           *)
  979. (***************************************************************************)
  980.  
  981. BEGIN
  982.      vc[1] := va[2] * vb[3] - va[3] * vb[2];
  983.      vc[2] := va[3] * vb[1] - va[1] * vb[3];
  984.      vc[3] := va[1] * vb[2] - va[2] * vb[1];
  985. END vcross_ss;
  986.  
  987.  
  988. PROCEDURE Veccompr_v (VECTOR a: REAL; VECTOR VAR va: Vec);
  989. (***************************************************************************)
  990. (*                                         *)
  991. (*  function:                                                               *)
  992. (*  stretching the vector va: va = a*va                                  *)
  993. (*                                                                           *)
  994. (***************************************************************************)
  995.  
  996. BEGIN
  997.      va[1] := a * va[1];
  998.      va[2] := a * va[2];
  999.      va[3] := a * va[3];
  1000. END Veccompr_v;
  1001.  
  1002.  
  1003. PROCEDURE Veccompr_s (SCALAR a: REAL; SCALAR VAR va: Vec);
  1004. (***************************************************************************)
  1005. (*                                         *)
  1006. (*  function:                                                               *)
  1007. (*  stretching the vector va: va = a*va                                    *)
  1008. (*                                                                           *)
  1009. (***************************************************************************)
  1010.  
  1011. BEGIN
  1012.      va[1] := a * va[1];
  1013.      va[2] := a * va[2];
  1014.      va[3] := a * va[3];
  1015. END Veccompr_s;
  1016.  
  1017.  
  1018. PROCEDURE Vecunit_v (VECTOR VAR va: Vec);
  1019. (***************************************************************************)
  1020. (*                                         *)
  1021. (*  function:                                                               *)
  1022. (*  vectorial calculation of the unitvector of va                   *)
  1023. (*                                                                           *)
  1024. (***************************************************************************)
  1025.  
  1026. VECTOR
  1027.      d: REAL;
  1028.  
  1029. BEGIN
  1030.      Vecdot_vv (va, va, d); 
  1031.      d := 1./Sqrt(d);     
  1032.      Veccompr_v (d, va);
  1033. END Vecunit_v;
  1034.  
  1035.  
  1036. PROCEDURE Vecunit_s (SCALAR VAR va: Vec);
  1037. (***************************************************************************)
  1038. (*                                         *)
  1039. (*  function:                                                               *)
  1040. (*  vectorial calculation of the unitvector of va                   *)
  1041. (*                                                                           *)
  1042. (***************************************************************************)
  1043.  
  1044. SCALAR
  1045.      d: REAL;
  1046.  
  1047. BEGIN
  1048.      Vecdot_ss (va, va, d); 
  1049.      d := 1./Sqrt(d);     
  1050.      Veccompr_s (d, va);
  1051. END Vecunit_s;
  1052.  
  1053.  
  1054. PROCEDURE dist (SCALAR va: Vec; VECTOR vb: Vec; VECTOR VAR d: REAL);
  1055. (***************************************************************************)
  1056. (*                                         *)
  1057. (*  function:                                                               *)
  1058. (*  calculation of the distance between two points                          *)
  1059. (*                                                                           *)
  1060. (***************************************************************************)
  1061.  
  1062. BEGIN
  1063.      d:= Sqrt ((va[1]-vb[1])**2 + (va[2]-vb[2])**2 + (va[3]-vb[3])**2);
  1064. END dist;
  1065.  
  1066.  
  1067.  
  1068.  
  1069. (************************* COLOR-PROcEDUREs **********************************)
  1070.  
  1071.  
  1072.  
  1073. PROCEDURE init_s (SCALAR VAR col: RGB);
  1074. (***************************************************************************)
  1075. (*                                                                           *)
  1076. (*  function:                                                               *)
  1077. (*  col get the color black                                                  *)
  1078. (*                                                                           *)
  1079. (***************************************************************************)
  1080.  
  1081. BEGIN
  1082.      col[1] := 0.;
  1083.      col[2] := 0.;
  1084.      col[3] := 0.;
  1085. END init_s;
  1086.  
  1087.  
  1088. PROCEDURE init_v (VECTOR VAR col: RGB);
  1089. (***************************************************************************)
  1090. (*                                         *)
  1091. (*  function:                                                               *)
  1092. (*  vector col get the color black                                          *)
  1093. (*                                                                           *)
  1094. (***************************************************************************)
  1095.  
  1096. BEGIN
  1097.      col[1] := 0.;
  1098.      col[2] := 0.;
  1099.      col[3] := 0.;
  1100. END init_v;
  1101.  
  1102.  
  1103. PROCEDURE coladd_vv (VECTOR a: REAL; VECTOR va, vb: RGB; VECTOR VAR vc: RGB);
  1104. (***************************************************************************)
  1105. (*                                         *)
  1106. (*  function:                                                               *)
  1107. (*  addition of colorvectors.                                 *)
  1108. (*                                                                           *)
  1109. (***************************************************************************)
  1110.  
  1111. BEGIN
  1112.      vc[1] := a  * va[1] + vb[1];
  1113.      vc[2] := a  * va[2] + vb[2];
  1114.      vc[3] := a  * va[3] + vb[3];
  1115. END coladd_vv;
  1116.  
  1117.  
  1118. PROCEDURE coladd_sv (VECTOR a: REAL; SCALAR va: RGB; VECTOR vb: RGB; 
  1119.                          VECTOR VAR vc: RGB);
  1120. (***************************************************************************)
  1121. (*                                         *)
  1122. (*  function:                                                               *)
  1123. (*  addition of colorvectors.                                 *)
  1124. (*                                                                           *)
  1125. (***************************************************************************)
  1126.  
  1127. BEGIN
  1128.      vc[1] := a  * va[1] + vb[1];
  1129.      vc[2] := a  * va[2] + vb[2];
  1130.      vc[3] := a  * va[3] + vb[3];
  1131. END coladd_sv;
  1132.  
  1133.  
  1134. PROCEDURE colmult_sv (SCALAR va: RGB; VECTOR vb: RGB; VECTOR VAR vc: RGB);
  1135. (***************************************************************************)
  1136. (*                                         *)
  1137. (*  function:                                                               *)
  1138. (*  multiplication of colorvectors.                       *)
  1139. (*                                                                           *)
  1140. (***************************************************************************)
  1141.  
  1142. BEGIN
  1143.      vc[1] := va[1] * vb[1];
  1144.      vc[2] := va[2] * vb[2];
  1145.      vc[3] := va[3] * vb[3];
  1146. END colmult_sv;
  1147.  
  1148.  
  1149.  
  1150. (*************************** OBJECT-PROCEDURES ******************************)
  1151.  
  1152.  
  1153.  
  1154.  
  1155. PROCEDURE sphere_normal (VECTOR s: Sphere; VECTOR p: Vec; VECTOR VAR n: Vec);
  1156. (***************************************************************************)
  1157. (*                                         *)
  1158. (*  function:                                                               *)
  1159. (*  calculating the normalvector of sphere s at point p.                    *)
  1160. (*                                                                           *)
  1161. (***************************************************************************)
  1162.  
  1163. BEGIN
  1164.      Veccomb_vv (-1.,1., s.center, p, n);
  1165.      Vecunit_v (n);
  1166. END sphere_normal;
  1167.  
  1168.  
  1169. PROCEDURE poly_normal (VECTOR poly: Polygon; VECTOR VAR n: Vec);
  1170. (***************************************************************************)
  1171. (*                                         *)
  1172. (*  function:                                                               *)
  1173. (*  calculating the normalvector of polygon poly                             *)
  1174. (*                                                                           *)
  1175. (***************************************************************************)
  1176.  
  1177. BEGIN
  1178.      n[1] := poly.normal[1];
  1179.      n[2] := poly.normal[2];
  1180.      n[3] := poly.normal[3];
  1181. END poly_normal;
  1182.  
  1183.  
  1184. PROCEDURE sphere_intersect (VECTOR p, d: Vec; VECTOR VAR t: REAL; 
  1185.                                 VECTOR VAR typ: ObjTyp; VECTOR VAR s: Sphere;
  1186.                                  VECTOR VAR hit: BOOLEAN);
  1187. (***************************************************************************)
  1188. (*                                         *)
  1189. (*  global variable:                                                      *)
  1190. (*  sl                                          *)
  1191. (*                                                                           *)
  1192. (*  function:                                                               *)
  1193. (*  Calculates the nearest intersection between ray with origin 'p' and    *)
  1194. (*  direction 'd'. The distance between intersection and origin has to be  *)
  1195. (*  less than 't'.                                                           *)
  1196. (*  The whole spherelist 'sl' would be passed and each new intersection    *)
  1197. (*  would be checked, if it lays before the other intersections. At the end*)
  1198. (*  get s the cutting sphere and t the multiplicator of the directionvector*)
  1199. (*  of which the intersection can be calculated.                           *)
  1200. (*                                                                           *)
  1201. (***************************************************************************)
  1202. SCALAR
  1203.      i: INTEGER;             (*  counter                   *)
  1204.  
  1205. VECTOR 
  1206.      v: Vec;                 (*  vector to center of sphere       *)
  1207.      b, vdot, disc, t1, t2: REAL;
  1208.      inters: BOOLEAN;
  1209.  
  1210.  
  1211. BEGIN
  1212.      FOR i := 1 TO sphcount DO
  1213.            Veccomb_vs (-1., 1., p, sl[i].center, v);
  1214.       Vecdot_vv (v, d, b);  
  1215.            Vecdot_vv (v, v, vdot);  
  1216.           disc := b*b - vdot + sl[i].radius**2;
  1217.           IF (disc <= 0.) THEN         (*  no cut                   *)
  1218.                  inters := FALSE;
  1219.           ELSE 
  1220.                 disc := Sqrt (disc);
  1221.                t2 := b + disc;
  1222.                IF (t2 < RayEps) THEN
  1223.                     inters := FALSE;
  1224.                ELSE
  1225.                     inters := TRUE;
  1226.                     t1 := b - disc;
  1227.                     IF (t1 < RayEps) THEN
  1228.                          t1 := t2;
  1229.                     END (* if *);
  1230.                END (* if *)
  1231.           
  1232.           END (* if *);
  1233.           IF (inters) & (t > t1) THEN     (*  new intersection lays before  *)
  1234.                           (*  the old one                   *)
  1235.                t := t1;
  1236.                 typ := sph;
  1237.                s := sl[i];
  1238.           END (* if *);
  1239.      END (* for *);
  1240.  
  1241.      IF typ = sph THEN
  1242.            hit := TRUE;
  1243.      ELSE
  1244.            hit := FALSE;
  1245.      END (* if *);
  1246. END sphere_intersect;
  1247.  
  1248.  
  1249. PROCEDURE poly_intersect (VECTOR p, d: Vec; VECTOR VAR tmax: REAL; 
  1250.                               VECTOR VAR typ: ObjTyp; VECTOR VAR pn: Polygon;
  1251.                                VECTOR VAR hit: BOOLEAN);
  1252. (***************************************************************************)
  1253. (*                                          *)
  1254. (*  subprocedure:                               *)
  1255. (*  in_out_test                                   *)
  1256. (*                                         *)
  1257. (*  global variable:                                                      *)
  1258. (*  pl                                      *)
  1259. (*                                                                           *)
  1260. (*  function:                                                               *)
  1261. (*  calculates intersection of ray, which run from p in direction d.       *)
  1262. (*                                                                           *)
  1263. (***************************************************************************)
  1264. SCALAR
  1265.      i: INTEGER;
  1266.  
  1267. VECTOR
  1268.      cosdn: REAL;             (*  pointproduct of normalvector  *)
  1269.                           (*  and falling-in ray            *)
  1270.      cospn: REAL;             (*  pointproduct of normalvector  *)
  1271.                           (*  and origin              *)
  1272.      t: REAL;                 (*  multiplicator of direction-   *)
  1273.                           (*  vector               *)
  1274.      point: Vec;             (*  meeting-point           *)
  1275.      inside: BOOLEAN;             (*  TRUE: point lay inside polygon*)
  1276.                           (*  FALSE: point lay outside      *)
  1277.  
  1278. PROCEDURE in_out_test (VECTOR p: Vec; SCALAR plentry: INTEGER;
  1279.                            VECTOR VAR inpoly: BOOLEAN);
  1280. (***************************************************************************)
  1281. (*                                         *)
  1282. (*  calling procedure:                               *)
  1283. (*  poly_intersect                               *)
  1284. (*                                                                           *)
  1285. (*  global variable:                                                      *)
  1286. (*  pl                                     *)
  1287. (*                                                                           *)
  1288. (*  function:                                                               *)
  1289. (*  Check, if point 'p' lay inside polygone at position 'plentry'.         *)
  1290. (*  Send one ray in one direction and count the intersections with         *)
  1291. (*  polygone-edges. If the number is even, then the point lay inside, else *)
  1292. (*  outside.                                                                 *) 
  1293. (*                                         *)
  1294. (***************************************************************************)
  1295.  
  1296. SCALAR
  1297.      i: INTEGER;             (*  counter                   *)
  1298.      v1, v2: Vec;             (*  current corner-points of      *)
  1299.  
  1300. BEGIN
  1301.      i := 1;
  1302.      inpoly := TRUE;
  1303.  
  1304.      WHILE inpoly & (i <= pl[plentry].vcount) DO
  1305.            IF i = pl[plentry].vcount THEN
  1306.            v2 := pl[plentry].vertices[1];
  1307.            ELSE
  1308.                 v2 := pl[plentry].vertices[i+1];
  1309.       END (* if *);
  1310.            v1 := pl[plentry].vertices[i];
  1311.            
  1312.            
  1313.            IF pl[plentry].xy THEN
  1314.  
  1315. (*  Projektion auf die x,y - Ebene                       *)
  1316.                 IF (((v1[2] - v2[2]) * p[1] + (v2[1] -v1[1]) * p[2] +
  1317.                        (v1[1]*v2[2]-v2[1]*v1[2]))*FLOAT (pl[plentry].side)<0.) THEN
  1318.                              inpoly := FALSE;
  1319.                 END (* if *);
  1320.            ELSIF pl [plentry].xz THEN                 
  1321.  
  1322. (*  projection to x,z  - plain                        *)
  1323.                 IF (((v1[3] - v2[3]) * p[1] + (v2[1] -v1[1]) * p[3] +
  1324.                        (v1[1]*v2[3]-v2[1]*v1[3]))*FLOAT (pl[plentry].side)<0.) THEN
  1325.                         inpoly := FALSE;
  1326.                 END (* if *);
  1327.            ELSE
  1328. (*  projection to y,z  - plain                        *)
  1329.                 IF (((v1[3] - v2[3]) * p[2] + (v2[2] -v1[2]) * p[3] +
  1330.                        (v1[2]*v2[3]-v2[2]*v1[3]))*FLOAT (pl[plentry].side)<0.) THEN
  1331.                         inpoly := FALSE;
  1332.  
  1333.                 END (* if *);
  1334.  
  1335.            END;
  1336.            INC (i);
  1337.      END;
  1338. END in_out_test;
  1339.  
  1340.                                            
  1341.  
  1342. BEGIN
  1343.      FOR i := 1 TO polycount DO
  1344.            Vecdot_sv (pl[i].normal, d, cosdn);
  1345.            IF cosdn <> 0. THEN                 (*  ray not parallel with plain *)
  1346.                 Vecdot_sv (pl[i].normal, p, cospn);
  1347.                 t := (-cospn - pl[i].d) / cosdn;
  1348.                 IF (t > RayEps) THEN         (*  hit lay before ray-origin *)
  1349.                         Veccomb_vv (1., t, p, d, point);
  1350.                         in_out_test (point, i, inside);
  1351.                         IF inside & (t < tmax) THEN
  1352.                              tmax := t;
  1353.                              pn := pl[i];
  1354.                              typ := poly
  1355.                         END;
  1356.                 END;
  1357.            END;
  1358.      END;
  1359.      IF typ = poly THEN
  1360.            hit := TRUE;
  1361.      END;
  1362. END poly_intersect;
  1363.  
  1364.  
  1365.  
  1366. (********************* ACTUAL RAYTRACE PROCEDURES *********************)
  1367.  
  1368.  
  1369.  
  1370.  
  1371. PROCEDURE trace (SCALAR depth: INTEGER; VECTOR VAR color: RGB;
  1372.                      VECTOR VAR r: Ray; VECTOR weight: REAL);
  1373. (***************************************************************************)
  1374. (*                                         *)
  1375. (*  global variable:                                                      *)
  1376. (*  color                                   *)
  1377. (*                                                                           *)
  1378. (*  function:                                                               *)
  1379. (*  Calculates intersection between 'r' and the nearest object.            *)
  1380. (*  Call of shadowing routine.                                              *)
  1381. (*                                                                           *)
  1382. (***************************************************************************)
  1383.  
  1384. VECTOR
  1385.      t: REAL;                 (*  parameter for calculating     *)
  1386.                           (*  intersection           *)
  1387.      obj: Object;
  1388.      hit: BOOLEAN;
  1389.      hitpoint: Vec;             (*  hitpoint               *)
  1390.      normal: Vec;             (*  normalvec at hitpoint       *)
  1391.      newcolor: RGB;             (*  color at hitpoint          *)
  1392.  
  1393. BEGIN
  1394.      t := 10000.;
  1395.      obj.typ := none;
  1396.      IF sphcount > 0 THEN
  1397.            sphere_intersect (r.p, r.d, t, obj.typ,
  1398.                                 obj.sph, hit);
  1399.      END;
  1400.      IF polycount > 0 THEN
  1401.            poly_intersect (r.p, r.d, t, obj.typ, 
  1402.                               obj.poly, hit);
  1403.      END;
  1404.  
  1405.      IF (obj.typ = sph) OR (obj.typ = poly) THEN
  1406.  
  1407.            (*  all rays which hit object        *)
  1408.            Veccomb_vv (1., t, r.p, r.d, hitpoint);
  1409.       IF obj.typ = sph THEN
  1410.            sphere_normal (obj.sph, hitpoint, normal);
  1411.            ELSE
  1412.                 poly_normal (obj.poly, normal);
  1413.            END;
  1414.                
  1415.            shade (depth, obj, hitpoint, r.d, normal, color, weight);
  1416.      ELSE
  1417.            color := background;
  1418.      END (* if *);
  1419.  
  1420. END trace;
  1421.  
  1422.  
  1423.  
  1424. PROCEDURE shade (SCALAR depth: INTEGER; VECTOR obj: Object; 
  1425.                   VECTOR point, d, normal: Vec;
  1426.                   VECTOR  VAR color: RGB; VECTOR weight: REAL);
  1427. (***************************************************************************)
  1428. (*                                         *)
  1429. (*  global variable:                                                      *)
  1430. (*  ll, sl, pl, amb, color                             *)
  1431. (*                                                                         *)
  1432. (*  function:                                                               *)
  1433. (*  Calculation of viewing ray d, which hit object in obj.sph respectively *)
  1434. (*  obj.poly (look obj.typ) at point p. Phong-Shading is used as shadowing *)
  1435. (*   model.                                                       *) 
  1436. (*                                                                           *)
  1437. (***************************************************************************)
  1438.  
  1439. SCALAR
  1440.      i: INTEGER;             (*  counter                   *)
  1441.  
  1442. VECTOR
  1443.      lcolor: RGB;             (*  color by light                *)
  1444.      l: Vec;                 (*  shading-ray to light          *)
  1445.      dst: REAL;                 (*  distance of light             *)
  1446.      sh: BOOLEAN;             (*  TRUE: point is lighted        *)
  1447.                           (*  FALSE: object lay between     *) 
  1448.                           (*  point and light               *)
  1449.      cosln: REAL;             (*  pointproduct of shading-ray   *)
  1450.                           (*  and normalvec                 *)
  1451.      cosnh: REAL;             (*  pointproduct of halfway-vec   *)
  1452.                           (*  and normalvec                 *)
  1453.      h: Vec;                 (*  halfway-vec between shading   *)
  1454.                           (*  and falling-in ray            *)
  1455.      hdot: REAL;             (*  pointproduct of halway-vec    *)
  1456.      f: RGB;                 (*  calculated Fresnel-values       *)
  1457.      oldweight: REAL;             (*  weighting factor of falling-in*)
  1458.                           (*  ray               *)
  1459.      spec: BOOLEAN;             
  1460.  
  1461.      trans: BOOLEAN;             (*  TRUE: ray would be transm.       *)
  1462.                           (*  FALSE: ray would be total refl*)
  1463.      newray: Ray;
  1464.      specweight: REAL;
  1465.      transweight: REAL;
  1466.      newweight: REAL;
  1467.      ksr, kst, mult: REAL;
  1468.      newcolor: RGB;
  1469.  
  1470. BEGIN
  1471. (*  colorquotas by ambient light and light-origins can be calculated direct*)
  1472. (*  for each ray.                                                          *)
  1473. (*  Phong - Shading: colorquota := amb. + diffus and spec. refl. light       *)
  1474.  
  1475.  
  1476.      IF obj.typ = sph THEN
  1477.            colmult_sv (amb, obj.sph.color, color);
  1478.      ELSE
  1479.            colmult_sv (amb, obj.poly.color, color);
  1480.      END;
  1481.  
  1482.      FOR i := 1 TO lightcount DO
  1483.            init_v (lcolor);
  1484.       Veccomb_vs (-1., 1., point, ll[i].pos, l);
  1485.            dist (ll[i].pos, point, dst);
  1486.            Vecunit_v (l);
  1487.            Vecdot_vv ( l, normal, cosln);
  1488.            shadow (point, l, dst, sh);
  1489.            IF sh & (cosln > 0.) THEN         (* no object in this direction *)
  1490.  
  1491. (*  halfway-vec between normalvec and directionvec for spec. reflection *)
  1492.                Veccomb_vv (-1., 1., d, l, h);
  1493.                 Vecdot_vv (h, h, hdot);
  1494.                 Veccompr_v (1. / Sqrt(hdot), h);
  1495.                 Vecdot_vv (normal, h, cosnh);
  1496.                 IF obj.typ = sph THEN
  1497.                         (* diffuser quota                       *)
  1498.                         colmult_sv (ll[i].intensity,obj.sph.color,lcolor);
  1499.                         coladd_vv (obj.sph.kdr*cosln,lcolor, color,color);
  1500.                         (* spec. quota                       *)
  1501.                         coladd_sv 
  1502.                         (obj.sph.ksr*cosnh**obj.sph.shine, ll[i].intensity,
  1503.                          color, color);
  1504.                 ELSE
  1505.                         (* diffuse quota                       *)
  1506.                         colmult_sv (ll[i].intensity,obj.poly.color,lcolor);
  1507.                         coladd_vv (obj.poly.kdr*cosln,lcolor, color,color);
  1508.                         (* spec. quota                       *)
  1509.                         coladd_sv 
  1510.                         (obj.poly.ksr*cosnh**obj.poly.shine, ll[i].intensity,
  1511.                          color, color);
  1512.                 END;
  1513.            END;
  1514.      END (* for *);
  1515.  
  1516. (*  max. depth still not achieved --> follow spec. and trans. ray further  *)
  1517.      IF (depth < MaxDepth) THEN
  1518.            IF obj.typ = sph THEN
  1519.                 specweight := weight * obj.sph.ksr;
  1520.                 transweight := weight * obj.sph.kst;
  1521.                 ksr := obj.sph.ksr;
  1522.                 kst := obj.sph.kst;
  1523.            ELSE
  1524.                 specweight := weight * obj.poly.ksr;
  1525.                 transweight := weight * obj.poly.kst;
  1526.                 ksr := obj.poly.ksr;
  1527.                 kst := obj.poly.kst;
  1528.            END;
  1529.  
  1530.            newray.p := point;
  1531.            init_v (newcolor);
  1532.            spec := FALSE;
  1533.            trans := FALSE;
  1534.  
  1535.            IF (specweight > MinWeight) THEN 
  1536.  
  1537. (* weight of spec. refl. ray relevant --> calculate spec. refl. rays       *)
  1538.                 specdir (d, normal, newray.d);
  1539.                 newweight := specweight;
  1540.                 spec := TRUE;
  1541.                 mult := ksr;
  1542.            ELSIF (transweight > MinWeight) THEN
  1543.                 transdir (obj, d, normal, newray.d, trans);
  1544.                 IF NOT trans THEN
  1545.                         specdir (d, normal, newray.d);
  1546.                         trans := TRUE;
  1547.                 END;
  1548.                 newweight := transweight;
  1549.                 mult := kst;
  1550.            END;
  1551.  
  1552.            IF spec OR trans THEN
  1553.                 trace (depth + 1, newcolor, newray, newweight);
  1554.                 coladd_vv (mult, newcolor, color, color); 
  1555.            END;
  1556.  
  1557.            IF spec AND (transweight > MinWeight) THEN
  1558.  
  1559. (* weight of transm. ray relevant --> calculate transm. rays       *)
  1560.                 transdir (obj, d, normal, newray.d, trans);
  1561.                 IF NOT trans THEN
  1562.                         specdir (d, normal, newray.d);
  1563.                 END;
  1564.                 init_v (newcolor);
  1565.                 trace (depth + 1, newcolor, newray, newweight);
  1566.                 coladd_vv (kst, newcolor, color,color);
  1567.  
  1568.            END (* if *);
  1569.  
  1570.      END (* if *);
  1571.            
  1572. END shade;
  1573.  
  1574.  
  1575.  
  1576. PROCEDURE shadow (VECTOR p, d: Vec; VECTOR tmax: REAL; VECTOR VAR b: BOOLEAN);
  1577. (***************************************************************************)
  1578. (*                                                                           *)
  1579. (*  function:                                                               *)
  1580. (*  Check, if shading-ray running from p hit another object, before he     *)
  1581. (*  reach the light in distance tmax.                                       *)
  1582. (*                                                                           *)
  1583. (***************************************************************************)
  1584.  
  1585. VECTOR
  1586.      hit: BOOLEAN;
  1587.      t: REAL;
  1588.      hitobj: Object;
  1589.  
  1590. BEGIN
  1591.      t := tmax;
  1592.      hitobj.typ := none;
  1593.      hit := FALSE;
  1594.      IF sphcount > 0 THEN
  1595.            sphere_intersect (p, d, t, hitobj.typ, hitobj.sph, hit);
  1596.      END;
  1597.      IF (NOT hit) OR (t > tmax - RayEps) THEN
  1598.            IF polycount > 0 THEN
  1599.                 poly_intersect (p, d, t, hitobj.typ, hitobj.poly, hit);
  1600.            END;
  1601.            IF (NOT hit) OR (t > tmax - RayEps) THEN
  1602.                 b := TRUE;             (*  ray reach light               *)
  1603.            ELSE
  1604.                 b := FALSE;
  1605.            END;
  1606.      ELSE
  1607.            b := FALSE;                      (*  ray hit object                *)
  1608.      END (* if *);
  1609. END shadow;
  1610.  
  1611.  
  1612. PROCEDURE specdir (VECTOR d, n: Vec; VECTOR VAR r: Vec);
  1613. (***************************************************************************)
  1614. (*                                         *)
  1615. (*  function:                                                               *)
  1616. (*  Calculates spec. reflect. ray of falling-in ray d at position with     *)
  1617. (*  normalvec n.                                                            *)
  1618. (*                                                                           *)
  1619. (***************************************************************************)
  1620.  
  1621. VECTOR
  1622.      dot: REAL;
  1623.  
  1624. BEGIN
  1625.      Vecdot_vv (d, n, dot);
  1626.      Veccomb_vv (-2.*dot, 1., n, d, r);
  1627. END specdir;
  1628.  
  1629.  
  1630. PROCEDURE transdir (VECTOR obj: Object; VECTOR d, n: Vec;
  1631.                         VECTOR VAR r: Vec; VECTOR VAR b: BOOLEAN);
  1632. (***************************************************************************)
  1633. (*                                         *)
  1634. (*  function:                                                               *)
  1635. (*  Calculates Transmission-direction of ray d through obj.sph resp.       *)
  1636. (*  obj.poly at position with normalvec n.                                  *)
  1637. (*                                                                           *)
  1638. (***************************************************************************)
  1639. VECTOR
  1640.      eta, c1, cs2: REAL;
  1641.  
  1642. BEGIN
  1643.      IF obj.typ = sph THEN
  1644.            eta := obj.sph.eta;
  1645.      ELSE
  1646.            eta := obj.poly.eta;
  1647.      END;
  1648.      Vecdot_vv (d, n, c1);
  1649.      IF c1 > 0. THEN
  1650.            eta := 1./eta;
  1651.      ELSE
  1652.            c1 := -c1;
  1653.      END;
  1654.  
  1655.      cs2 := 1. - eta**2 * (1. - c1**2);
  1656.      IF (cs2 < 0.) THEN
  1657.            b := FALSE;
  1658.      END;
  1659.      Veccomb_vv (eta, eta*c1-Sqrt(cs2),d, n, r);
  1660.      b := TRUE;
  1661. END transdir;
  1662.  
  1663.  
  1664. BEGIN (* main *) 
  1665.       
  1666.      (*   planes  initrays round  Veccomb_vv  Veccomb_vs Veccomb_ss
  1667.      Vecdot_vv Vecdot_sv Vecdot_ss vcross_ss Veccompr_v Veccompr_s 
  1668.      Vecunit_v Vecunit_s dist coladd_vv coladd_sv colmult_sv 
  1669.     sphere_normal poly_normal sphere_intersect 
  1670.     poly_intersect in_out_test trace shade shadow specdir transdir *)  
  1671.  
  1672.      WriteString ("Objectfile (without extension '.nff') : ");
  1673.      ReadString (inputf);
  1674.  
  1675.      objfile := strcat( inputf , ".nff");
  1676.      picfile := strcat( inputf , ".out.ppm");
  1677.  
  1678.      WriteLn;
  1679.      WriteString( "  Objectfile : " );
  1680.      WriteString( objfile ); WriteLn;
  1681.      WriteString( "  Outputfile : " );
  1682.      WriteString( picfile ); WriteLn; WriteLn;
  1683.  
  1684.      createscene;                            
  1685.      IF polycount > 0 THEN
  1686.            planes;
  1687.      END;
  1688.  
  1689.      initrays;
  1690.  
  1691.      PARALLEL
  1692.            trace (0, color, iray, 1.);
  1693.      ENDPARALLEL;
  1694.  
  1695.      STORE (color, pixfield);
  1696.  
  1697.      OpenOutput (picfile);
  1698.  
  1699.      WriteString( "P6"); WriteLn;
  1700.  
  1701.      WriteInt (Size, 1); WriteLn;
  1702.      WriteInt (Size, 1); WriteLn;
  1703.      WriteInt (255, 1) ; WriteLn;
  1704.  
  1705.      FOR i := 1 TO Size DO
  1706.            FOR j := 1 TO Size DO
  1707.                 aktu_color := pixfield[i][j];
  1708.  
  1709. (*  normalize color                               *)
  1710.                 m := aktu_color[1];
  1711.                 IF aktu_color[2] > m THEN
  1712.                         m := aktu_color[2];
  1713.                 END;                
  1714.  
  1715.                 IF aktu_color[3] > m THEN
  1716.                         m := aktu_color[3];
  1717.                 END;
  1718.                 IF m > 1. THEN
  1719.                         aktu_color[1] := aktu_color[1] / m;
  1720.                         aktu_color[2] := aktu_color[2] / m;
  1721.                         aktu_color[3] := aktu_color[3] / m;
  1722.            END;
  1723.  
  1724.                Write ( CHR(round (aktu_color[1]*255.)));
  1725.                Write ( CHR(round (aktu_color[2]*255.)));
  1726.                Write ( CHR(round (aktu_color[3]*255.)));
  1727.            END;
  1728.      END;
  1729.      CloseOutput;
  1730.  
  1731. END sys_trace.
  1732.